home *** CD-ROM | disk | FTP | other *** search
/ The Atari Compendium / The Atari Compendium (Toad Computers) (1994).iso / files / prgtools / programm.ing / gfa / gfaexprt.lzh / GFAXPERT.LIB / MUSIC.LST < prev    next >
Encoding:
File List  |  1986-10-19  |  9.6 KB  |  321 lines
  1. ' *****************
  2. ' *** MUSIC.LST ***
  3. ' *****************
  4. '
  5. DEFWRD "a-z"
  6. '
  7. > PROCEDURE play.song(play$)
  8.   ' *** play song (XBIOS 32 - format)
  9.   ' *** Keyclick temporarily switched off
  10.   ' *** Song-file not larger than 32767 bytes
  11.   ' *** global :   PLAY.SONG!   SONG.ADRES%
  12.   LOCAL bytes,song$
  13.   IF EXIST(play$)
  14.     play.song!=TRUE
  15.     IF (PEEK(&H484) AND 1)=1
  16.       SPOKE &H484,(PEEK(&H484) XOR 1)         ! key-click off
  17.     ENDIF
  18.     OPEN "I",#90,play$
  19.     bytes=LOF(#90)
  20.     CLOSE #90
  21.     song$=SPACE$(bytes)
  22.     song.adres%=VARPTR(song$)
  23.     BLOAD play$,song.adres%
  24.     VOID XBIOS(32,L:song.adres%)
  25.   ELSE
  26.     play.song!=FALSE
  27.   ENDIF
  28. RETURN
  29. ' ***
  30. > PROCEDURE stop.song
  31.   ' *** abort song, switch Keyclick on
  32.   WAVE 0,0
  33.   IF (PEEK(&H484) AND 1)=0
  34.     SPOKE &H484,(PEEK(&H484) OR 1)         ! key-click on
  35.   ENDIF
  36.   play.song!=FALSE
  37. RETURN
  38. ' **********
  39. '
  40. > PROCEDURE interrupt.song
  41.   ' *** interrupt X32-song temporarily to do something important
  42.   ' *** uses global variable song.adres% (Procedure Play.song)
  43.   LOCAL i,adres%
  44.   IF play.song!
  45.     ERASE register()
  46.     DIM register(15)
  47.     adres%=XBIOS(32,L:-1)               ! where are we ?
  48.     FOR i=0 TO 15
  49.       register(i)=XBIOS(28,0,i)         ! store registers
  50.     NEXT i
  51.     IF (PEEK(&H484) AND 1)=0
  52.       SPOKE &H484,(PEEK(&H484) OR 1)    ! key-click on
  53.     ENDIF
  54.   ENDIF
  55.   '
  56.   WAVE 0,0
  57.   ' *** do something important here
  58.   '
  59.   PAUSE 100                             ! just an example, not very important
  60.   '
  61.   ' *** continue the interrupted song
  62.   IF play.song!
  63.     IF (PEEK(&H484) AND 1)=1
  64.       SPOKE &H484,(PEEK(&H484) XOR 1)   ! key-click off
  65.     ENDIF
  66.     FOR i=0 TO 15
  67.       ~XBIOS(28,register(i),i OR 128)   ! restore registers
  68.     NEXT i
  69.     IF adres%=0
  70.       adres%=song.adres%
  71.     ENDIF
  72.     ~XBIOS(32,L:adres%)                  ! music, maestro ...
  73.   ENDIF
  74. RETURN
  75. ' **********
  76. '
  77. > PROCEDURE play.cont.song(play$)
  78.   ' *** play song continuously (XBIOS 32 - format)
  79.   ' *** uses EVERY to test every 1 second if song is finished
  80.   ' *** remember, EVERY doesn't work during "long" commands (~INP(2),PAUSE,etc.)
  81.   ' *** Keyclick temporarily switched off
  82.   ' *** Song-file not larger than 32767 bytes (use MALLOC for larger songs)
  83.   ' *** global :   CONT.SONG!   SONG.ADR%
  84.   LOCAL bytes,song$
  85.   IF EXIST(play$)
  86.     cont.song!=TRUE
  87.     IF (PEEK(&H484) AND 1)=1
  88.       SPOKE &H484,(PEEK(&H484) XOR 1)         ! key-click off
  89.     ENDIF
  90.     OPEN "I",#90,play$
  91.     bytes=LOF(#90)
  92.     CLOSE #90
  93.     song$=SPACE$(bytes)
  94.     song.adr%=VARPTR(song$)
  95.     BLOAD play$,song.adr%
  96.     EVERY 200 GOSUB check.song
  97.     ~XBIOS(32,L:song.adr%)
  98.   ELSE
  99.     cont.song!=FALSE
  100.   ENDIF
  101. RETURN
  102. ' ***
  103. > PROCEDURE check.song
  104.   IF XBIOS(32,L:-1)=0
  105.     ~XBIOS(32,L:song.adr%)
  106.   ENDIF
  107. RETURN
  108. ' ***
  109. > PROCEDURE stop.cont.song
  110.   ' *** abort song, switch Keyclick on
  111.   EVERY STOP
  112.   WAVE 0,0
  113.   IF (PEEK(&H484) AND 1)=0
  114.     SPOKE &H484,(PEEK(&H484) OR 1)         ! key-click on
  115.   ENDIF
  116.   cont.song!=FALSE
  117. RETURN
  118. ' **********
  119. '
  120. > PROCEDURE initio.soundmachine(file$)
  121.   ' *** load and play Soundmachine-song file$
  122.   ' *** songs created by The Soundmachine ST (TommySoftware)
  123.   ' *** song (*.SNG) compiled to Precode-file (*.DAT)
  124.   ' *** program SMSOUND.EXE plays song; reset necessary because of RESERVE 3 !
  125.   ' *** global :   SM.FLAG%
  126.   LOCAL s$,cmd$,k
  127.   s$=STRING$(4,0)
  128.   RESERVE 50000                   ! Soundmachine needs a lot of space
  129.   cmd$=file$+"  "+STR$(V:s$)
  130.   cmd$=CHR$(LEN(cmd$)+1)+cmd$
  131.   EXEC 0,"SMSOUND.EXE",cmd$,""    ! load and start (change path if necessary)
  132.   sm.flag%=CVL(s$)
  133.   IF sm.flag%=0
  134.     ALERT 3,"Can't load| |SMSOUND.EXE",1,"EDIT",k
  135.     RESERVE
  136.     EDIT
  137.   ENDIF
  138. RETURN
  139. ' ***
  140. > PROCEDURE soundmachine(flag!)
  141.   ' *** if restart-flag is set in program, restart of song is possible :
  142.   ' ***           POKE sm.flag%+7,1         ! set restart-flag
  143.   ' ***           FOR t=1 TO 10000          ! wait
  144.   ' ***           NEXT t
  145.   ' ***           @soundmachine(on!)        ! restart song
  146.   ' *** abort song with @soundmachine(off!)
  147.   '
  148.   IF flag!                     ! sound on
  149.     SDPOKE &H452,0             ! no VBL
  150.     SLPOKE &HFF8800,&H7007F00  ! load sound-register
  151.     SPOKE &HFFFA1D,0           ! system-timer off (no click,menu,break,etc.)
  152.     SPOKE &HFFFA17,64          ! MFP AEoI-mode
  153.     SPOKE &HFFFA19,1           ! start timer A
  154.   ELSE                         ! sound off
  155.     SPOKE &HFFFA19,0           ! timer A off (2x !!)
  156.     SPOKE &HFFFA19,0
  157.     SPOKE &HFFFA17,72          ! MFP SEoI-mode
  158.     SPOKE &HFFFA1D,81          ! system-timer on (GEM alive again)
  159.     SDPOKE &H452,1             ! VBL
  160.   ENDIF
  161. RETURN
  162. ' **********
  163. '
  164. > PROCEDURE sm.initio(object$,buffer%)
  165.   ' *** reserve space for object-file and load it
  166.   ' *** also reserve space for buffer (if object-file contains compressed song)
  167.   ' *** use @sm.exit to restore memory
  168.   LOCAL object%,m$,k,res.mem%,bufp%
  169.   IF EXIST(object$)
  170.     OPEN "I",#90,object$
  171.     object%=LOF(#90)
  172.     CLOSE #90
  173.   ELSE
  174.     m$="Sorry, can't|find the file|"+object$
  175.     ALERT 3,m$,1,"QUIT",k
  176.     @exit
  177.   ENDIF
  178.   res.mem%=object%+buffer%+256     ! 256 not necessary ?
  179.   RESERVE -res.mem%                ! reserve space for object-file + buffer
  180.   sm.sam%=MALLOC(object%)          ! space for object-file (see SAMLINK.PRG)
  181.   sm.taon%=sm.sam%+&H186           ! special function (see Procedure Sm.space)
  182.   sm.taoff%=sm.sam%+&H1B6          !
  183.   sm.flags%=sm.sam%+&HE76          ! address of the 8 Flags
  184.   bufp%=sm.sam%+&HE7E              ! points to a buffer (for the unpacked music)
  185.   BLOAD object$,sm.sam%            ! load object-file
  186.   ~XBIOS(38,L:sm.sam%)             ! call assembler-routine in Supervisor-mode !
  187.   SDPOKE &H452,0                   ! disable VBL
  188.   IF buffer%>0
  189.     sm.song%=MALLOC(buffer%)       ! space for the buffer (see SAMLINK.PRG)
  190.     LPOKE (bufp%),sm.song%         ! tell buffer-address to SOUNDMACHINE
  191.   ENDIF
  192. RETURN
  193. ' *****
  194. > PROCEDURE sm.flag(flag,value)
  195.   ' *** assign value (0-255) to flag (0-7)
  196.   BYTE{sm.flags%+flag}=value
  197. RETURN
  198. ' *****
  199. > PROCEDURE sm.start.x100
  200.   ' *** start Soundmachine song (compressed song will be decompressed first)
  201.   ' *** use this for X100-mode only
  202.   ' *** song can be stopped only (<Space>) if Procedure Sm.space is switched on
  203.   @sm.space(on!)
  204.   SPOKE &HFFFA19,1
  205.   @sm.wait
  206.   @sm.space(off!)
  207. RETURN
  208. ' *****
  209. > PROCEDURE sm.wait
  210.   ' *** wait until Restart recognized
  211.   REPEAT
  212.   UNTIL PEEK(&HFFFA19)=0
  213. RETURN
  214. ' *****
  215. > PROCEDURE sm.start.x66
  216.   ' *** start Soundmachine song (compressed song will be decompressed first)
  217.   ' *** use this for X66-mode only
  218.   SPOKE &HFFFA19,1
  219. RETURN
  220. ' *****
  221. > PROCEDURE sm.stop.x66
  222.   ' *** stop Soundmachine song
  223.   ' *** this works only in X66-mode (Flag 7 is set to 1)
  224.   @sm.flag(7,1)
  225.   @sm.wait
  226. RETURN
  227. ' *****
  228. > PROCEDURE sm.space(switch!)
  229.   ' *** after @sm.space(TRUE) the song will stop playing after detecting <Space>
  230.   ' *** this works in X100-mode !
  231.   ' *** this function uses XBIOS-calls to detect the keypress
  232.   ' *** don't forget to disable this funcion with @sm.space(FALSE) !!
  233.   IF switch!
  234.     CALL sm.taon%
  235.   ELSE
  236.     CALL sm.taoff%
  237.   ENDIF
  238. RETURN
  239. ' *****
  240. > PROCEDURE sm.exit
  241.   ' *** exit Soundmachine; restore memory (a few bytes are lost)
  242.   LOCAL dummy%,m$,k
  243.   IF sm.song%>0
  244.     dummy%=MFREE(sm.song%)            ! return buffer to GEMDOS
  245.     IF dummy%<>0
  246.       m$="*** WARNING ***| |MFREE-error with|Song-buffer"
  247.       ALERT 3,m$,1," OK ",k
  248.     ENDIF
  249.   ENDIF
  250.   SDPOKE &H452,1                      ! VBL on
  251.   SPOKE &HFFFA1D,80                   ! Systemtimer on (200 Hz)
  252.   dummy%=MFREE(sm.sam%)               ! return memory to GEMDOS
  253.   IF dummy%<>0
  254.     m$="*** WARNING ***| |MFREE-error with|Object-file"
  255.     ALERT 3,m$,1," OK ",k
  256.   ENDIF
  257.   RESERVE                             ! return memory to GFA-Basic
  258. RETURN
  259. ' **********
  260. '
  261. > PROCEDURE msm.initio(object$)
  262.   ' *** reserve space for object-file and load it
  263.   ' *** use @msm.exit to restore memory
  264.   LOCAL object%,m$,k
  265.   IF EXIST(object$)
  266.     OPEN "I",#90,object$
  267.     object%=LOF(#90)
  268.     CLOSE #90
  269.   ELSE
  270.     m$="Sorry, can't|find the file|"+object$
  271.     ALERT 3,m$,1,"QUIT",k
  272.     @exit
  273.   ENDIF
  274.   res.mem%=object%+256               ! 256 not necessary ?
  275.   RESERVE -res.mem%                  ! reserve space for object-file
  276.   msm.chip%=MALLOC(object%)          ! allocate space for object-file
  277.   msm.flags%=msm.chip%+&HC64         ! address of the Flags
  278.   msm.systim%=LPEEK(&H114)           ! 200 Hz Systemtimer (Timer C)
  279.   BLOAD object$,msm.chip%            ! load object-file
  280.   VOID XBIOS(38,L:msm.chip%)         ! call assembler-routine in Supervisor-mode
  281. RETURN
  282. ' *****
  283. > PROCEDURE msm.start
  284.   ' *** start Mini-Soundmachine song
  285.   SPOKE &HFFFA1D,16
  286. RETURN
  287. ' *****
  288. > PROCEDURE msm.stop
  289.   ' *** stop Mini-Soundmachine song (set Flag 7 to 1)
  290.   @msm.flag(7,1)
  291.   REPEAT
  292.   UNTIL PEEK(&HFFFA1D)=0
  293. RETURN
  294. ' *****
  295. > PROCEDURE msm.effect(effect,freq)
  296.   ' *** play sound-effect from Mainsong
  297.   ' *** frequency 245000/freq Hz  (freq : 11-255)
  298.   @msm.flag(9,freq)
  299.   @msm.flag(8,effect)
  300. RETURN
  301. ' *****
  302. > PROCEDURE msm.flag(flag,value)
  303.   ' *** assign value to flag
  304.   BYTE{msm.flags%+flag}=value
  305. RETURN
  306. ' *****
  307. > PROCEDURE msm.exit
  308.   ' *** exit Mini-Soundmachine; restore memory (a few bytes are lost)
  309.   LOCAL dummy%,m$,k
  310.   @msm.stop
  311.   dummy%=MFREE(msm.chip%)                ! return memory to GEMDOS
  312.   IF dummy%<>0
  313.     m$="*** WARNING ***| |MFREE-error with|Object-file"
  314.     ALERT 3,m$,1," OK ",k
  315.   ENDIF
  316.   VOID XBIOS(31,2,80,192,L:msm.systim%)  ! switch back to Timer C
  317.   RESERVE                                ! return memory to GFA-Basic
  318. RETURN
  319. ' **********
  320. '
  321.